(*
	XModem command,folderName,fileName -- Send or receive a file using the XModem protocol. If
		command is "receive", then receive a file and name it as specified. If the command is "send",
		then send the named file. The folder and file name are separate so that the file can be downloaded
		into the right folder before knowing the proper name. Assume the serial port has already been opened.

	This XModem implementation handles normal XModem and CRC XModem. It does not know anything
	about the format of the data being sent or received -- i.e., it doesn't know anything about MacBinary.

	It sends very fast. Receive could be sped up some (it should compute the CRC as it's receiving, not
	afterward), but it isn't all that bad either.

	To compile and link this file using Macintosh Programmer's Workshop,

		pascal -w XModem.p
		link -m ENTRYPOINT -o HyperCommands -rt XCMD=7036 -sn Main=XModem ¶
			XModem.p.o "{MPW}"Libraries:interface.o "{MPW}"PLibraries:PasLib.o

	© Copyright 1987,88 by Apple Computer, Inc.

	Initial coding 9/87 by Harry R. Chesley.
*)

{$R-}

{$S XModem } 	{ Segment name must be the same as the command name. }

unit DummyUnit;

interface

uses MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;

procedure EntryPoint(paramPtr: XCmdPtr);
	
implementation

type

Str31 = String[31];

procedure XModem(paramPtr: XCmdPtr); forward;

procedure EntryPoint(paramPtr: XCmdPtr);

	begin
		XModem(paramPtr);
	end;

{ÇXModem(paramPtr: XCmdPtr)È}

procedure XModem(paramPtr: XCmdPtr);

	const TEMPFILENAME = '*** recvXModemTemp ***';
		RETRY = 5;
		RECSIZE = 128;
		EOT = 4;
		CRC = ord('C');
		ACK = 6;
		NAK = $15;
		CAN = $18;
		SOH = 1;

	var theFolder: str255;
		theFile: Str255;
		tempFile: str255;
		cmd: Str255;												{ The command. }
		dummy: OSErr;
		fileRef: integer;											{ Input or output file reference number. }
		useCRC: boolean;											{ True if we're using CRCs. }
		crcAccum, checkSum: longInt;						{ The CRC or checksum. }
		buffer: array [1..RECSIZE] of SignedByte;		{ The I/O buffer. }
		recNum: longInt;											{ The current record number. }

	{$I XCmdGlue.inc}

	procedure Fail(errMsg: Str255);
		{ Set theResult and quit. }
		begin
			paramPtr^.returnValue := PasToZero(errMsg);
			exit(XModem);
		end;

	{$I SPortUtil.inc}

{ÇMiscellaneous RoutinesÈ	Miscellaneous Routines }

	function byteAvailable: boolean;
		{ Returns true if a serial port input byte is available. }

		var l: longInt;

		begin
			if SerGetBuf(ThisSPort.portInDev,l) <> noErr then Fail('SerGetBuf failed');
			byteAvailable :=  l > 0;
		end;

	function readOne: SignedByte;
		{ Reads a byte from the serial port. }

		var l: longInt;
			theByte: SignedByte;

		begin
			l := 1;
			if FSRead(ThisSPort.portInDev,l,@theByte) <> noErr then Fail('FSRead failed');
			readOne := theByte;
		end;

	procedure tx(b: SignedByte);
		{ Transmits a byte to to serial port. }

		var theByte: SignedByte;
			l: longInt;

		begin
			theByte := b;
			l := 1;
			if FSWrite(ThisSPort.portOutDev,l,@theByte) <> noErr then Fail('FSWrite failed');
		end;

	function swait: SignedByte;
		{ Waits up to 2 seconds for a byte from the serial port. }

		var stoppingTime: longInt;
			theByte: SignedByte;
			l: longInt;

		begin
			stoppingTime := TickCount + 120;
			while TickCount < stoppingTime do
				if byteAvailable then
					begin
						swait := readOne;
						exit(swait);
					end;
			swait := 0;
		end;

	procedure clearInput;
		{ Clear out any residual characters on the input port. }

		var theByte: SignedByte;

		begin
			while byteAvailable do theByte := readOne;
		end;

	procedure sleep(ticks: longInt);
		{ Wait for ticks 1/60ths of a second. }

		var finalTime: longInt;

		begin
			finalTime := TickCount + ticks;
			repeat until TickCount >= finalTime;
		end;

{ÇCRC/Checksum RoutinesÈ	CRC/Checksum Routines }

	procedure clrCrc;
		{ Clear out the CRC/checksum. }

		begin
			crcAccum := 0;
			checkSum := 0;
		end;

	procedure updCrc(b: SignedByte);
		{ Process one more byte into the CRC/Checksum. }

		var i: integer;
			flag: longInt;

		begin
			if useCRC then
				begin
					for i := 7 downto 0 do
						begin
							flag := BitAnd(crcAccum,$08000);
							crcAccum := BitShift(crcAccum,1);
							if BitAnd(BitShift(1,i),b) <> 0 then crcAccum := BitOr(crcAccum,1);
							if flag <> 0 then crcAccum := BitXor(crcAccum,$01021);
						end;
				end
			else checkSum := checkSum + BitAnd(b,$FF);
		end;

{ÇsendFileÈ}

	procedure sendFile;
		{ Open and send a file. }

		var didSend: boolean;		{ True if send was successfull. }

		function send: boolean;
			{ Send the file (once it's been opened). }

			var i: integer;

			procedure Fail(errMsg: Str255);
				{ Set theResult and quit. }

				var dummy: OSErr;

				begin
					dummy := FSClose(fileRef);
					paramPtr^.returnValue := PasToZero(errMsg);
					exit(XModem);
				end;

			function waitCan(t: longInt): SignedByte;
				{ Wait up to t ticks for a byte from the serial port. }
	
				var stopTime: longInt;
					theByte: SignedByte;
	
				begin
					stopTime := TickCount+t;
					while TickCount < stopTime do
						if byteAvailable then
							begin
								theByte := readOne;
								if theByte = CAN then exit(send);
								waitCan := theByte;
								exit(waitCan);
							end;
					waitCan := 0;
				end;
	
			procedure synch;
				{ Synchronize our ACKs/NAKs and figure out if we're doing CRCs or checksums. }
	
				var i: integer;
					theByte: SignedByte;
	
				begin
					clearInput;
					{ Try up to ten times to synchronize. }
					for i := 1 to 10 do
						begin
							{ Get a character. }
							theByte := waitCan(600);
							{ Check for NAK Ñ normal, checksum XModem. }
							if theByte = NAK then
								begin
									useCRC := false;
									exit(synch);
								end;
							{ Check for CRC Ñ CRC style XModem. }
							if theByte = CRC then
								begin
									useCRC := true;
									exit(synch);
								end;
						end;
					{ Didn't find it. Give up. }
					Fail('could not synchronize');
				end;

			function fillBuf: boolean;
				{ Get a bufferfull from disk. }

				var l: longInt;

				begin
					l := RECSIZE;
					if (FSRead(fileRef,l,@buffer) <> noErr) or (l = 0) then fillBuf := false
					else fillBuf := true;
				end;

			procedure txRec;
				{ Transmit one record. }

				var i, j: integer;
					theByte: SignedByte;

				begin
					clearInput;
					{ Try to send the record up to 25 times. }
					for i := 1 to 25 do
						begin
							{ Send the record header. }
							tx(SOH);
							tx(BitAnd(recNum,$FF));
							tx(BitAnd(BitXor(recNum,$FF),$FF));
							{ Send the record body, figuring the CRC as we go. }
							clrCrc;
							for j := 1 to RECSIZE do
								begin
									tx(buffer[j]);
									updCrc(buffer[j]);
								end;
							updCrc(0); updCrc(0);
							{ Send the CRC. }
							if useCrc then
								begin
									tx(BitAnd(BitShift(crcAccum,-8),$FF));
									tx(BitAnd(crcAccum,$FF));
								end
							else tx(BitAnd(checkSum,$FF));
							{ Wait for the ACK. }
							if waitCan(600) = ACK then
								begin
									{ If we succeeded, increment the record number. }
									recNum := recNum+1;
									exit(txRec);
								end;
						end;
						Fail('retries exceeded')
				end;

			begin
				{ Initialize and synchronize with the other side. }
				send := false;
				recNum := 1;
				synch;
				{ Send the file, one record at a time. }
				while fillBuf do txRec;
				{ Make sure he knows we're all done. }
				for i := 1 to 100 do
					begin
						tx(EOT);
						if waitCan(60) = ACK then leave;
					end;
				send := true;
			end;

		begin
			{ Open the file to be sent. }
			if FSOpen(theFile,0,fileRef) <> noErr then Fail('no such file');
	
			{ Send the file. }
			didSend := send;

			{ Close the file. }
			if FSClose(fileRef) <> noErr then Fail('FSClose failed');
			if not didSend then Fail('send aborted');
		end;

{ÇreceiveFileÈ}

	procedure receiveFile;
		{ Create and receive one file. }

		var didReceive: boolean;		{ True if the receive was successfull. }
				i: integer;
				lastColon: integer;
				volName: str255;

		function receive: boolean;
			{ Receive the file (once it has been created on disk). }
	
			var i: integer;
				theByte: SignedByte;
				response: SignedByte;
				r1, r2: longInt;
				crcHi, crcLo: longInt;
				l: longInt;

			procedure Fail(errMsg: Str255);
				{ Set theResult and quit. }

				var dummy: OSErr;

				begin
					dummy := FSClose(fileRef);
					paramPtr^.returnValue := PasToZero(errMsg);
					exit(XModem);
				end;

			begin
				{ Assume we'll fail: }
				receive := false;
	
				{ Dump any previous residue: }
				clearInput;
	
				{ Assume we're doing CRC XModem: }
				response := CRC;
				useCRC := true;
	
				{ Start at record one: }
				recNum := 1;
	
				{ Read in the file: }
				while true do
					begin
						{ Synch up: }
						clearInput;
						for i := 1 to 10*RETRY do
							begin
								{ Let him know what happened last time (or NAK him the first time). }
								tx(response);
								{ Get a byte. }
								theByte := swait;
								{ Check or start-of-record. }
								if theByte = SOH then leave;
								{ Check for end-of-file. }
								if theByte = EOT then
									begin
										tx(ACK);
										receive := true;
										exit(receive);
									end;
								{ Check for manual cancel. }
								if theByte = CAN then exit(receive);
								{ If we've tried CRCs for a while, try checksums now. }
								if i = 5*RETRY then
									begin
										if response = CRC then
											begin
												response := NAK;
												useCRC := false;
											end
										else leave;
									end;
							end;
						{ If this isn't another block, it must be that we've run out of retries. }
						if theByte <> SOH then exit(receive);
						{ Receive the record number (and its complement). }
						r1 := BitAnd(swait,$FF); r2 := BitAnd(swait,$FF);
						{ Receive the record. }
						for i := 1 to RECSIZE do buffer[i] := swait;
						{ Receive the CRC/checksum. }
						if useCRC then crcHi := BitAnd(swait,$FF);
						crcLo := BitAnd(swait,$FF);
						{ Assume this one'll be bad. }
						response := NAK;
						{ Check for bad record number. }
						if BitAnd(BitNot(r1),$FF) <> r2 then cycle;
						{ Check for bad CRC/checksum. }
						clrCrc;
						for i := 1 to RECSIZE do updCrc(buffer[i]);
						updCrc(0); updCrc(0);
						if useCRC then
							begin
								if (crcLo + BitShift(crcHi,8)) <> BitAnd(crcAccum,$0FFFF) then
									begin
										{ Give things time to settle out. }
										sleep(120);
										cycle;
									end;
							end
						else if crcLo <> BitAnd(checkSum,$FF) then
							begin
								{ Give things time to settle out. }
								sleep(120);
								cycle;
							end;
						{ Check if this is a record we've already received. }
						if r1 = BitAnd(recNum-1,$FF) then
							begin
								{ If it is... }
								response := ACK;
								cycle;
							end;
						{ Check if this record is WAY out of sequence. }
						if r1 <> BitAnd(recNum,$FF) then Fail('fatal record sequencing error');
						{ Increment our expected record number. }
						recNum := recNum+1;
						{ Write the record to disk. }
						l := RECSIZE;
						if FSWrite(fileRef,l,@buffer) <> noErr then Fail('FSWrite failed');
						response := ACK;
					end;
			end;

		begin
			{ Create the temporary input file (will be renamed later to the real name if we make it OK). }
			dummy := FSDelete(tempFile,0);
			if Create(tempFile,0,'????','????') <> noErr then Fail('could not create temp file');
			if FSOpen(tempFile,0,fileRef) <> noErr then Fail('FSOpen failed on temp file');
	
			{ Receive the file: }
			didReceive := receive;

			{ Close the file, and rename the temporary file to the permanent name. }
			if FSClose(fileRef) <> noErr then Fail('FSClose failed');
			if didReceive then
				begin
					dummy := FSDelete(theFile,0);
					if Rename(tempFile,0,theFile) <> noErr then Fail('Rename failed');
				end
			else
				begin
					if FSDelete(tempFile,0) <> noErr then Fail('FSDelete failed');
					Fail('receive aborted');
				end;
			lastColon := 0;
			for i := 1 to length(theFile) do
				if theFile[i] = ':' then lastColon := i;
			if lastColon = 0 then volName := ''
			else volName := Copy(theFile,1,lastColon);
			if FlushVol(@volName,0) <> noErr then Fail('FlushVol failed');
		end;

{ÇMain ProgramÈ	Main Program }

	begin
		{ Check the parameter count. }
		if paramPtr^.paramCount <> 3 then Fail('parameter count is not 3');

		{ Get the parameters. }
		GetStrParm(1,cmd);				{ First parameter is the command. }
		GetStrParm(2,theFolder);		{ Second parameter is the folder to put the file in. }
		tempFile := Concat(theFolder,TEMPFILENAME);
		GetStrParm(3,theFile);			{ Third parameter is file name to send/receive. }
		theFile := Concat(theFolder,theFile);

		SetUpSPortGlobals;
		EnsureOpenPort;

		{ Find out what command we're doing and do it. }
		if StringEqual(cmd,'send') then sendFile
		else if StringEqual(cmd,'receive') then receiveFile
		else Fail('invalid command');
	end;

end.
